Amiga Tools 5/Amiga Tools 5.iso/tools/developer-tools/andere sprachen/oberonv4/oberon-src/system/display.mod

Oberon Text | 1996-02-14 | 15.2 KB | 312 lines

Syntax10.Scn.Fnt
ParcElems
Alloc
Syntax24b.Scn.Fnt
StampElems
Alloc
14 Feb 96
Syntax10b.Scn.Fnt
Syntax10i.Scn.Fnt
(* AMIGA *)
MODULE Display; (* shml/cn
    IMPORT SYSTEM,Amiga,G:=AmigaGraphics,I:=AmigaIntuition, Pictures;
    CONST
        black* = Pictures.black; white* = Pictures.white;
        replace* = Pictures.replace; (* The new graphical object completely replaces whatever was before in the destination area. *)
        paint* = Pictures.paint; (* The new graphical object is added to whatever was before in the dertination area. *)
        invert* = Pictures.invert; (* The new graphical object inverts whatever was before in the dertination area. The color specifies, which planes are affected (inverted) and which aren't *)
    TYPE
        Type Frame is declared in this module, but not used, except for defining the clipping areas in
        the ...C procedures. It's module Viewer, which actually uses the dsc, next and handle fields.
        So why aren't they part of ViewerDesc?
        X,Y,W and H define the bounding box of a frame.
        Frame* = Pictures.Frame;
        FrameMsg* = Pictures.FrameMsg;
        Handler* = Pictures.Handler;
        FrameDesc* = Pictures.FrameDesc;
        Pattern* = Pictures.Pattern;
        Font* = POINTER TO Bytes;    (*Amiga.Font*)
        Bytes* = RECORD END;
    TYPE
        Location=RECORD offset,width:INTEGER END;
        LocationArray=ARRAY 256 OF Location;
        LocationPtr=POINTER TO LocationArray;
        SpaceArray=ARRAY 256 OF INTEGER;
        SpacePtr=POINTER TO SpaceArray;
        KernArray=ARRAY 256 OF INTEGER;
        KernPtr=POINTER TO KernArray;
        RastPortPtr=POINTER TO G.RastPort;
        ScreenPtr=POINTER TO I.Screen;
        TextFontPtr=POINTER TO G.TextFont;
        WindowPtr=POINTER TO I.Window;
        Unit*: LONGINT; (*RasterUnit = Unit/36000 mm*)
        Left*, ColLeft*, Bottom*, Width*, Height*: INTEGER;
        arrow*, star*, hook*, cross*, downArrow*: Pattern;
        grey0*, grey1*, grey2*, ticks*: Pattern;
        screen-:Pictures.Picture;
        nofCols: INTEGER;
    PROCEDURE NewPattern*(VAR image: ARRAY OF SET; w, h: INTEGER): Pattern;
    (* Allocates a new pattern with width w and height h. The i-th pattern line from bottom (increasing y-value)
        corresponds to the image entries (i+1)*lineLen .. (i+2)*lineLen-1, where lineLen = (w+31) DIV 32.
        The set elements desribe the pixels from left to right (increasing x-value). *)
    BEGIN
        RETURN Pictures.NewPattern(image,w,h)
    END NewPattern;
    (* Get the Address of Video-RAM, not possible at the AMIGA *)
    PROCEDURE Map*(X, Y: INTEGER): LONGINT;
    BEGIN
        RETURN 0
    END Map;
    (* Activate DIsplay, only one Display realized at the moment *)
    PROCEDURE SetMode*(X: INTEGER; s: SET);
    BEGIN
    END SetMode;
    PROCEDURE SetColor*(col, red, green, blue: INTEGER); (*col < 0: overlay color not supported on the Amiga*)
        Set the RGB values for a color.
        scr:ScreenPtr;
        win: WindowPtr;
    BEGIN
        win := SYSTEM.VAL(WindowPtr, Amiga.window);
        scr := SYSTEM.VAL(ScreenPtr, win.wScreen);
        IF G.gfxVersion<39 THEN
            G.SetRGB4(
                SYSTEM.VAL(G.ViewPortPtr,SYSTEM.ADR(scr.viewPort)),col MOD nofCols,red DIV 16,green DIV 16,blue DIV 16
        ELSE
            G.SetRGB32(
                SYSTEM.VAL(G.ViewPortPtr,SYSTEM.ADR(scr.viewPort)),col MOD nofCols,
                SYSTEM.LSH(LONG(red),24),SYSTEM.LSH(LONG(green),24),SYSTEM.LSH(LONG(blue),24)
        END
    END SetColor;
    PROCEDURE GetColor*(col: INTEGER; VAR red, green, blue: INTEGER);
        Return the RGB values for a color.
        long:LONGINT;
        rgbTable:RECORD r,g,b:LONGINT END;
        scr:ScreenPtr;
        win: WindowPtr;
    BEGIN
        win := SYSTEM.VAL(WindowPtr, Amiga.window);
        scr:=SYSTEM.VAL(ScreenPtr, win.wScreen);
        IF G.gfxVersion<39 THEN
            long:=G.GetRGB4(scr.viewPort.colorMap,col MOD nofCols);
            red:=SHORT(long DIV 256 MOD 16)*17;
            green:=SHORT(long DIV 16 MOD 16)*17;
            blue:=SHORT(long MOD 16)*17
        ELSE
            G.GetRGB32(scr.viewPort.colorMap,col MOD nofCols,1,rgbTable);
            red:=SHORT(SYSTEM.LSH(rgbTable.r,-24));
            green:=SHORT(SYSTEM.LSH(rgbTable.g,-24));
            blue:=SHORT(SYSTEM.LSH(rgbTable.b,-24))
        END
    END GetColor;
    PROCEDURE GetChar*(f: Font; ch: CHAR; VAR dx, x, y, w, h: INTEGER; VAR p: Pattern);
        (*get raster data of character ch*)
    VAR charInfo: Amiga.CharInfo; raster: Amiga.Font;
    BEGIN
        raster := SYSTEM.VAL(Amiga.Font, f); charInfo := raster.info[ORD(ch)];
        dx := charInfo.dx; x := charInfo.x; y := charInfo.y; w := charInfo.w; h := charInfo.h;
        p := SYSTEM.ADR(raster.info[ORD(ch)])
    END GetChar;
    (*raster operations*)
    PROCEDURE CopyBlock*(SX, SY, W, H, DX, DY, mode: INTEGER);
        Copy a rectangular area within the display to another place. This procedure assumes, that any single
        area does not cross the boundary between primary and secondary screen.
    BEGIN
        Pictures.CopyBlock(screen,screen,SX, SY, W, H, DX, DY, mode)
    END CopyBlock;
    PROCEDURE CopyBlockC*(f: Frame; SX, SY, W, H, DX, DY, mode: INTEGER);
        As CopyBlock, but the destination area is clipped against the Frame boundary.
    BEGIN
        Pictures.CopyBlockC(screen,screen,f, SX, SY, W, H, DX, DY, mode)
    END CopyBlockC;
    PROCEDURE CopyPattern*(col: INTEGER; pat: Pattern; X, Y, mode: INTEGER);
        Copy a pattern to the specified location.
    BEGIN
        Pictures.CopyPattern(screen, col, pat, X, Y, mode)
    END CopyPattern;
    PROCEDURE CopyPatternC*(f: Frame; col: INTEGER; pat: Pattern; X, Y, mode: INTEGER);
        As CopyPattern, but clips the pattern against the frame boundary.
    BEGIN
        Pictures.CopyPatternC(screen, f, col, pat, X, Y, mode)
    END CopyPatternC;
    PROCEDURE ReplPattern*(col: INTEGER; pat: Pattern; X, Y, W, H, mode: INTEGER);
        Fill the specified area with the pattern.
    BEGIN
        Pictures.ReplPattern(screen,col,pat,X,Y,W,H,mode)
    END ReplPattern;
    PROCEDURE ReplPatternC*(f: Frame; col: INTEGER; pat: Pattern; X, Y, W, H, X0, Y0, mode: INTEGER);
        (* Replicates a pattern pat within the block (X, Y, W, H), clipped against F. The pattern origin is X0, Y0; i.e. for each
            completely visible occurrence of the pattern pat the following holds: ((x - X0) MOD w = 0) & ((y-Y0) MOD h = 0)
            where (x, y) denotes the left and bottom corner, and (w, h) the size of the pattern. *)
    BEGIN
        Pictures.ReplPatternC(screen,f,col,pat,X,Y,W,H,X0,Y0,mode)
    END ReplPatternC;
    PROCEDURE ReplConst*(col: INTEGER; X, Y, W, H, mode: INTEGER);
        Generate a rectangle with the specified color and paint mode.
    BEGIN
        Pictures.ReplConst(screen,col,X,Y,W,H,mode)
    END ReplConst;
    PROCEDURE ReplConstC*(f: Frame; col: INTEGER; X, Y, W, H, mode: INTEGER);
        As ReplConst, but the rectangle is clipped against the frame boundary.
    BEGIN
        Pictures.ReplConstC(screen,f,col,X,Y,W,H,mode)
    END ReplConstC;
    PROCEDURE Dot*(col: INTEGER; X, Y, mode: INTEGER);
        Change a single pixel.
    BEGIN
        Pictures.Dot(screen,col,X,Y,mode)
    END Dot;
    PROCEDURE DotC*(f: Frame; col: INTEGER; X, Y, mode: INTEGER);
         As Dot, but the the pixel is only written, if contained within the frame boundary.
    BEGIN
        Pictures.DotC(screen,f,col,X,Y,mode)
    END DotC;
    PROCEDURE CreatePatterns;
        Create the images for the exported patterns.
        VAR image: ARRAY 17 OF SET;
    BEGIN
        image[1] := {13};
        image[2] := {12..14};
        image[3] := {11..13};
        image[4] := {10..12};
        image[5] := {9..11};
        image[6] := {8..10};
        image[7] := {7..9};
        image[8] := {0, 6..8};
        image[9] := {0, 1, 5..7};
        image[10] := {0..2, 4..6};
        image[11] := {0..5};
        image[12] := {0..4};
        image[13] := {0..5};
        image[14] := {0..6};
        image[15] := {0..7};
        arrow := NewPattern(image, 15, 15);
        image[1] := {0, 10};
        image[2] := {1, 9};
        image[3] := {2, 8};
        image[4] := {3, 7};
        image[5] := {4, 6};
        image[6] := {};
        image[7] := {4, 6};
        image[8] := {3, 7};
        image[9] := {2, 8};
        image[10] := {1, 9};
        image[11] := {0, 10};
        cross := NewPattern(image,11,11);
        image[1] := {6};
        image[2] := {5..7};
        image[3] := {4..8};
        image[4] := {3..9};
        image[5] := {2..10};
        image[6] := {5..7};
        image[7] := {5..7};
        image[8] := {5..7};
        image[9] := {5..7};
        image[10] := {5..7};
        image[11] := {5..7};
        image[12] := {5..7};
        image[13] := {5..7};
        image[14] := {5..7};
        image[15] := {};
        downArrow := NewPattern(image,15,15);
        image[1] := {0, 4, 8, 12};
        image[2] := {};
        image[3] := {2, 6, 10, 14};
        image[4] := {};
        image[5] := {0, 4, 8, 12};
        image[6] := {};
        image[7] := {2, 6, 10, 14};
        image[8] := {};
        image[9] := {0, 4, 8, 12};
        image[10] := {};
        image[11] := {2, 6, 10, 14};
        image[12] := {};
        image[13] := {0, 4, 8, 12};
        image[14] := {};
        image[15] := {2, 6, 10, 14};
        image[16] := {};
        grey0 := NewPattern(image,16,16);
        image[1] := {0, 2, 4, 6, 8, 10, 12, 14};
        image[2] := {1, 3, 5, 7, 9, 11, 13, 15};
        image[3] := {0, 2, 4, 6, 8, 10, 12, 14};
        image[4] := {1, 3, 5, 7, 9, 11, 13, 15};
        image[5] := {0, 2, 4, 6, 8, 10, 12, 14};
        image[6] := {1, 3, 5, 7, 9, 11, 13, 15};
        image[7] := {0, 2, 4, 6, 8, 10, 12, 14};
        image[8] := {1, 3, 5, 7, 9, 11, 13, 15};
        image[9] := {0, 2, 4, 6, 8, 10, 12, 14};
        image[10] := {1, 3, 5, 7, 9, 11, 13, 15};
        image[11] := {0, 2, 4, 6, 8, 10, 12, 14};
        image[12] := {1, 3, 5, 7, 9, 11, 13, 15};
        image[13] := {0, 2, 4, 6, 8, 10, 12, 14};
        image[14] := {1, 3, 5, 7, 9, 11, 13, 15};
        image[15] := {0, 2, 4, 6, 8, 10, 12, 14};
        image[16] := {1, 3, 5, 7, 9, 11, 13, 15};
        grey1 := NewPattern(image,16,16);
        image[1] := {0, 1, 4, 5, 8, 9, 12, 13};
        image[2] := {0, 1, 4, 5, 8, 9, 12, 13};
        image[3] := {2, 3, 6, 7, 10, 11, 14, 15};
        image[4] := {2, 3, 6, 7, 10, 11, 14, 15};
        image[5] := {0, 1, 4, 5, 8, 9, 12, 13};
        image[6] := {0, 1, 4, 5, 8, 9, 12, 13};
        image[7] := {2, 3, 6, 7, 10, 11, 14, 15};
        image[8] := {2, 3, 6, 7, 10, 11, 14, 15};
        image[9] := {0, 1, 4, 5, 8, 9, 12, 13};
        image[10] := {0, 1, 4, 5, 8, 9, 12, 13};
        image[11] := {2, 3, 6, 7, 10, 11, 14, 15};
        image[12] := {2, 3, 6, 7, 10, 11, 14, 15};
        image[13] := {0, 1, 4, 5, 8, 9, 12, 13};
        image[14] := {0, 1, 4, 5, 8, 9, 12, 13};
        image[15] := {2, 3, 6, 7, 10, 11, 14, 15};
        image[16] := {2, 3, 6, 7, 10, 11, 14, 15};
        grey2 := NewPattern(image,16,16);
        image[1] := {0..7};
        image[2] := {0..6};
        image[3] := {0..5};
        image[4] := {0..4};
        image[5] := {0..3};
        image[6] := {0..2};
        image[7] := {0..1};
        image[8] := {0};
        hook := NewPattern(image,8,8);
        image[1] := {7};
        image[2] := {7};
        image[3] := {2, 7, 12};
        image[4] := {3, 7, 11};
        image[5] := {4, 7, 10};
        image[6] := {5, 7, 9};
        image[7] := {6..8};
        image[8] := {0..6, 8..14};
        image[9] := {6..8};
        image[10] := {5, 7, 9};
        image[11] := {4, 7, 10};
        image[12] := {3, 7, 11};
        image[13] := {2, 7, 12};
        image[14] := {7};
        image[15] := {7};
        star := NewPattern(image,15,15);
        image[1] := {0};
        image[2] := {};
        image[3] := {};
        image[4] := {};
        image[5] := {};
        image[6] := {};
        image[7] := {};
        image[8] := {};
        image[9] := {};
        image[10] := {};
        image[11] := {};
        image[12] := {};
        image[13] := {};
        image[14] := {};
        image[15] := {};
        image[16] := {};
        ticks := NewPattern(image,16,16)
    END CreatePatterns;
BEGIN
    Left := 0; ColLeft := 0; Bottom := 0;
    Width := Amiga.Width; Height := Amiga.Height; Unit := 14000;
    nofCols:=SHORT(ASH(1, Amiga.Depth));
    CreatePatterns;
    Pictures.WindowToPicture(Amiga.window,screen)
END Display.